home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE08 / DATADICT / CREATEDD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-07  |  5.3 KB  |  161 lines
  1. unit Createdd;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   StdCtrls, ExtCtrls, Forms, Buttons, DB, DBTables, dialogs,
  8.   utils;
  9.  
  10.  
  11.  
  12. type
  13.   TCreateDDForm = class(TForm)
  14.     BitBtn1: TBitBtn;
  15.     BitBtn2: TBitBtn;
  16.     BitBtn3: TBitBtn;
  17.     Label1: TLabel;
  18.     L_DDname: TLabel;
  19.     ProgressWindow: TMemo;
  20.     Label2: TLabel;
  21.     L_Tablename: TLabel;
  22.     procedure FormShow(Sender: TObject);
  23.     function doit(sender: tObject): boolean;
  24.     procedure BitBtn1Click(Sender: TObject);
  25.     procedure BitBtn2Click(Sender: TObject);
  26.     procedure FormCreate(Sender: TObject);
  27.   private
  28.     fpathName,
  29.     fTableName : string;
  30.   end;
  31.  
  32. var
  33.   CreateDDForm: TCreateDDForm;
  34.  
  35. implementation
  36. uses mainmenu;
  37. {$R *.DFM}
  38.  
  39. function TcreateDDform.doit(Sender : Tobject): boolean;
  40. begin
  41.   progressWindow.lines.clear;
  42.   progressWindow.visible := true;
  43.   progressWindow.lines.add('Starting build...');
  44.   try
  45.     main.sourceDatabase.close;
  46.     main.SourceDatabase.Params.clear;
  47.     main.SourceDatabase.Params.Add('PATH='+fPathName);
  48.     main.SourceDatabase.open;
  49.     with main.dicttable do begin
  50.       active := false;
  51.       databasename := main.sourceDatabase.databasename;
  52.       tablename := fTableName;
  53.       tabletype := ttdBase;
  54.       with FieldDefs do begin
  55.         clear;
  56.         Add('TABLE_NAME', ftString, 20, false);
  57.         Add('TABLE_TYPE', ftString, 20, false);
  58.         Add('FIELD_NAME', ftstring, 20, false);
  59.         Add('TAG',        ftstring, 20, false);
  60.         Add('SCR_PROMPT', ftString, 40, false);
  61.           {tfield.DisplayName, Value to show name of field}
  62.         Add('SCR_FMT'   , ftString, 80, false);
  63.           {tfield.DisplayText  formating rules for display}
  64.         Add('GRD_PROMPT', ftstring, 10, false);
  65.           {tfield.DisplayLabel, label in DbGrid}
  66.         Add('GRD_WIDTH',  ftsmallint, 0, false);
  67.           {tfield.DisplayWidth defaults to 10 except for character}
  68.         Add('FIELD_TYPE', ftstring, 12, false);
  69.           {letter code from appsuprt.fieldTypeLtr}
  70.         Add('FIELD_LEN',  ftsmallint, 0, false);
  71.           {tfield.size:
  72.             For a TStringField, Size is the number of bytes reserved for the field in the dataset.
  73.             For a TBCDField, it is the number of digits following the decimal point.
  74.             For a TBlobField, TBytesField, TVarBytesField, TMemoField or TGraphicField it is the size
  75.             of the field as stored in the table.}
  76.         Add('FIELD_DEC',  ftsmallint, 0, false);
  77.            {only used in formating float numbers}
  78.         Add('FIELD_IDX',  ftBoolean,  0, false);
  79.            { flag to indicate creation of index}
  80.         Add('IDX_EXPRES', ftMemo,   254, False);
  81.            { Expression for index, if any}
  82.         Add('TAB_ORDER',  ftsmallint, 0, false);
  83.            { index order in table}
  84.         Add('REQUIRED',   ftBoolean,  0, false);
  85.            {tfield.required}
  86.         Add('DEFAULT',    ftString,   80, false);
  87.            {if there is a default value}
  88.         Add('EDITMASK',   ftString, 80, false);
  89.            {tfield.EditMask to control input}
  90.         Add('MinVal',     ftFloat, 0, false);
  91.         Add('MaxVal',     ftFloat, 0, false);
  92.         Add('ValList',    ftMemo,   1024, false);
  93.         Add('DEFINE',     ftMemo,   1024, false);
  94.            {documentation memo}
  95.         Add('VALIDVALUE', ftMemo,   1024, false);
  96.            {for numeric fields: t(whatever).minValue, maxvalue
  97.             for string fields, a comma delimited list}
  98.         Add('NOTES',      ftMemo,   1024, false);
  99.            {documentation memo}
  100.         Add('HINT',       ftString, 120, false);
  101.            {hint text}
  102.         Add('HELPID',     ftInteger, 0,  false);
  103.            {help context id number}
  104.         Add('HELP',       ftMemo,   1024, false);
  105.            {help file text}
  106.         Add('HASLINK',    ftBoolean, 0, false);
  107.            {If true, then uses a table look up to get data}
  108.         Add('SRCLINKTBL', ftString, 20, false);
  109.            {table to look in}
  110.         Add('SRCLINKFLD', ftString, 20, false);
  111.            {field to get value from}
  112.         ADD('IS_CALC',    ftBoolean, 0, false);
  113.            {Calculated field, build at runtime only}
  114.         ADD('FORMULA',    ftMemo,   1024, false);
  115.            {documentation memo about how calc is done}
  116.         end;  {with fielddefs}
  117.       progressWindow.lines.add('Fields defined...');
  118.       createTable;
  119.       Result := true;
  120.       end;  {with table1}
  121.     progressWindow.lines.add('Empty Dictionary Built.');
  122.     except
  123.       on EdatabaseError do
  124.         begin
  125.           MessageDLg('Error attempting to create DD file.',
  126.                    mtInformation, [mbOK], 0);
  127.           Result := false;
  128.         end;
  129.       end;  {except block}
  130. end;
  131.  
  132. procedure Tcreateddform.BitBtn1Click(Sender: TObject);
  133. begin
  134.    if doit(sender)
  135.      then ModalResult := mrYes
  136.      else ModalResult := mrNo;
  137. end;
  138.  
  139. procedure TCreateDDForm.FormShow(Sender: TObject);
  140. begin
  141.   fPathName := extractFilePath(main.newddname);
  142.   fTableName := extractFileName(main.newddname);
  143.   fTableName := copy(fTableName, 1, pos('.', ftableName)-1);
  144.   l_ddname.caption := fpathname;
  145.   l_tablename.caption := ftablename;
  146. end;
  147.  
  148.  
  149. procedure TCreateDDForm.BitBtn2Click(Sender: TObject);
  150. begin
  151.   close;
  152. end;
  153.  
  154.  
  155. procedure TCreateDDForm.FormCreate(Sender: TObject);
  156. begin
  157.   scaleForm(sender);
  158. end;
  159.  
  160. end.
  161.